home *** CD-ROM | disk | FTP | other *** search
/ Netware Super Library / Netware Super Library.iso / pgm_tool / tpnet5 / sample.pas < prev   
Pascal/Delphi Source File  |  1990-03-04  |  45KB  |  1,269 lines
  1. {
  2. Turbo Pascal 5.0 example program for Novell Netware interface
  3. Novell functions are declared in PASNETA unit rather than the main program.
  4.  
  5. based on TPNET.ZIP for versions of Turbo Pascal prior to 4.0
  6.  
  7. Donald M. DeLapp
  8. 485 S. Sheridan Ave.
  9. Sheridan, WY 82801
  10. 307-674-6841
  11. }
  12.  
  13. { This program has been designed to give software developers an example of how to
  14.   interface with the assembly library provided.  The library has been revised
  15.   and the version contained on this disk should be used in place of the original 
  16.   library that came with the programmers' guide diskette. The programmmers'guide 
  17.   will help provide a better understanding of what parameters each call 
  18.   needs and how each function works. The following declaration needs to made 
  19.   whenever the library routines are accessed, since all function calls are 
  20.   referenced from the "xtndopn" function.
  21.                    BE SURE AND DECLARE THE FOLLOWING:
  22.    function xtndopn(var mode,handle:integer;var filename:str):integer; external 'PASNETA.COM'; }
  23.  
  24. {===========================================================================================}
  25. {$V-}
  26.  
  27. program FuncInterface;
  28.  
  29. Uses Dos, Crt, PASNETA;
  30.  
  31.     type       str = string[52];
  32.  
  33.     var
  34.         hex,filename,asciiz,sema4,recstr,request,reply: str;
  35.          Handle, retcode, Hoff, Loff, HLen, LLen, FLAG, TMO, Func, Attribute: integer;
  36.          semavalu,Hihandle,Lohandle,opencnt,volume,newserv: integer;
  37.          I, Len, mode, seg, off: integer;
  38.          ans: char;
  39.  
  40. {pasneta.pas
  41. this file contains the function and procedure declarations
  42. for the TurboPascal/Advanced NetWare interface}
  43.     
  44. type
  45.     Strvar = String[52];
  46.  
  47. {removed for TP 5.0-----------------------------------------------------------
  48. function xtndopn(var Mode, Handle: Integer;var Filename: Strvar): Integer; external 'PASNETA.COM';
  49. function setattr(var Func, Attribute: Integer; var Filename: Strvar): Integer; external xtndopn[3];
  50. function eojstat(var Flag: Integer):integer; external xtndopn[6];
  51. function PRLH_Log(var FileHandle,HiByteOffset,LoByteOffset,HiLockLen,
  52.       LoLockLen,Flags,TimeOut: Integer): Integer; external xtndopn[9];
  53. function PRLH_Rel(var FileHandle,HiByteOffset,LoByteOffset,HiLockLen,
  54.       LoLockLen: Integer): Integer; external xtndopn[12];
  55. function PRLH_Clr(var FileHandle,HiByteOffset,LoByteOffset,HiLockLen,
  56.       LoLockLen: Integer): Integer; external xtndopn[15];
  57. function PRLF_Log(var fcb,HiByteOffset,LoByteOffset,HiLockLen,LoLockLen,
  58.       Flags,TimeOut: Integer): Integer; external xtndopn[18];
  59. function PRLF_Rel(var fcb,HiByteOffset,LoByteOffset: Integer): Integer; external xtndopn[21];
  60. function PRLF_Clr(var fcb,HiByteOffset,LoByteOffset: Integer): Integer; external xtndopn[24];
  61. function PRLS_Lck(var Flags,TimeOut: Integer): Integer; external xtndopn[27];
  62. function PRLS_Rel: Integer; external xtndopn[30];
  63. function PRLS_Clr: Integer; external xtndopn[33];
  64. function OpenSem(var Sema4: Strvar; var SemaValu,HiHandle,LoHandle,OpenCnt: Integer): Integer; external xtndopn[36];
  65. function ExamSem(var HiHandle,LoHandle,SemaValu,OpenCnt: Integer): Integer; external xtndopn[39];
  66. function WaitSem(var HiHandle,LoHandle,TimeOut: Integer): Integer; external xtndopn[42];
  67. function SigSem(var HiHandle,LoHandle: Integer): Integer; external xtndopn[45];
  68. function ClosSem(var HiHandle,LoHandle: Integer): Integer; external xtndopn[48];
  69. function setlck(var Func: Integer): Integer; external xtndopn[51];
  70. function BakOuts(var Func: Integer): Integer; external xtndopn[54];
  71. function btrans(var Mode: Integer): Integer; external xtndopn[57];
  72. function etrans: Integer; external xtndopn[60];
  73. function exclog(var FcbAddr: Integer): Integer; external xtndopn[63];
  74. function exclcks(var Mode: Integer): Integer; external xtndopn[66];
  75. function exculkf(var FcbAddr: Integer): Integer; external xtndopn[69];
  76. function exculks: Integer; external xtndopn[72];
  77. function excclrf(var FcbAddr: Integer): Integer; external xtndopn[75];
  78. function excclrs: Integer; external xtndopn[78];
  79. function reclog(var RecStr: Strvar;var flag,TimeOut:integer): Integer; external xtndopn[81];
  80. function reclck(var Mode: Integer): Integer; external xtndopn[84];
  81. function reculk(var Semaphore: Strvar): Integer; external xtndopn[87];
  82. function reculks: Integer; external xtndopn[90];
  83. function recclr(var Semaphore: Strvar): Integer; external xtndopn[93];
  84. function recclrs: Integer; external xtndopn[96];
  85. function eoj: Integer; external xtndopn[99];
  86. function sysout: Integer; external xtndopn[102];
  87. function volstat(var volume: Integer;var reply: Strvar): Integer; external xtndopn[105];
  88. function locdrv:Integer; external xtndopn[108];
  89. function wsid: Integer; external xtndopn[111];
  90. function errmode(var mode: Integer):integer; external xtndopn[114];
  91. function bcsmode(var mode: Integer):integer; external xtndopn[117];
  92. function ctlspl(var Mode: Integer): Integer; external xtndopn[120];
  93. function splreq(var RequestBlock, Reply: Strvar): Integer; external xtndopn[123];
  94. function pipreq(var RequestBlock, Reply: Strvar): Integer; external xtndopn[126];
  95. function dpath(var RequestBlock, Reply: Strvar): Integer; external xtndopn[129];
  96. function syslog(var RequestBlock, Reply: Strvar): Integer; external xtndopn[132];
  97. function fattr(var FcbAddr, Attribute: Integer): Integer; external xtndopn[135];
  98. function updfcb(var FcbAddr: Integer): Integer; external xtndopn[138];
  99. function cpyfile(var FcbSource, FcbDest, CountLow, CountHigh: Integer): Integer; external xtndopn[141];
  100. function nettod(var time: Strvar):integer; external xtndopn[144];
  101. function clsmode(var mode: Integer):integer; external xtndopn[147];
  102. function drvmap(var drive: Integer): Integer; external xtndopn[150];
  103. function retshl(var EnvirStr: Strvar; var Mode: Integer): Integer; external xtndopn[153];
  104. function asclog(var Flags, TimeOut: Integer;var Asciiz: Strvar): Integer; external xtndopn[156];
  105. function asculkf(var Asciiz: Strvar): Integer; external xtndopn[159];
  106. function ascclrf(var Asciiz: Strvar): Integer; external xtndopn[162];
  107. function Get_PSN: Integer; external xtndopn[165];
  108. function Get_STA(var Mode,Segment,Offset: Integer):integer; external xtndopn[168];
  109. function SetServ(var Mode,NewServ: Integer): Integer; external xtndopn[171];
  110. function ModServ(var Mode,NewServ: Integer): Integer; external xtndopn[174];
  111. ------------------------------------------------------------------------------}
  112.  
  113. procedure Explain;
  114.     
  115.     begin
  116.       writeln('This program will display a menu of different function calls that can be');
  117.     writeln('performed. Each call will prompt the user for the parameters needed by the');
  118.       writeln('the function call.  After a function call has completed execution, the user ');
  119.       writeln('must hit the <enter> key to get back to the main menu.  This program has ');
  120.       writeln('been written to provide examples of how to use the function call interfaces,');
  121.         writeln('contained in pasneta.asm');
  122.       write('       Type return to continue: ');
  123.       readln;
  124.       clrscr;
  125.     end;
  126.  
  127.  
  128. function HexConvert(num:integer):str;
  129.     var quot, rem: integer;
  130.         dum:str;
  131.  
  132.     begin
  133.       quot:=num div 16;
  134.       rem:= num mod 16;
  135.       case rem of
  136.            0:hex:='0'+hex;
  137.            1:hex:='1'+hex;
  138.            2:hex:='2'+hex;
  139.             3:hex:='3'+hex;
  140.            4:hex:='4'+hex;
  141.            5:hex:='5'+hex;
  142.            6:hex:='6'+hex;
  143.             7:hex:='7'+hex;
  144.             8:hex:='8'+hex;
  145.             9:hex:='9'+hex;
  146.             10:hex:='A'+hex;
  147.             11:hex:='B'+hex;
  148.             12:hex:='C'+hex;
  149.             13:hex:='D'+hex;
  150.             14:hex:='E'+hex;
  151.             15:hex:='F'+hex;
  152.         end;
  153.         if quot > 15 then 
  154.             dum:=HexConvert(quot)
  155.         else
  156.            begin
  157.             case quot of
  158.                  0:hex:='0'+hex;
  159.                  1:hex:='1'+hex;
  160.                  2:hex:='2'+hex;
  161.                  3:hex:='3'+hex;
  162.                     4:hex:='4'+hex;
  163.                      5:hex:='5'+hex;
  164.                  6:hex:='6'+hex;
  165.                      7:hex:='7'+hex;
  166.                     8:hex:='8'+hex;
  167.                      9:hex:='9'+hex;
  168.                  10:hex:='A'+hex;
  169.                  11:hex:='B'+hex;
  170.                  12:hex:='C'+hex;
  171.                  13:hex:='D'+hex;
  172.                  14:hex:='E'+hex;
  173.                  15:hex:='F'+hex;
  174.             end;
  175.            end;
  176.         hexconvert:=hex;
  177.     end;
  178.  
  179.  
  180. procedure get_filename;
  181.   
  182.     begin
  183.         write('Enter the name of the file you want to use:  ');
  184.        readln(filename);
  185.        write('Press the <enter> key to begin .....');
  186.        readln;
  187.        Len:=length(filename);
  188.        filename[Len+1]:=chr(0);        { Make it an ASCIIZ string }
  189.   end;
  190.  
  191.  
  192. (************************************************************************)
  193. (* Open_File is the Novell Extended Open Function Call. It opens the    *)
  194. (* file shareable, read/write.                                          *)
  195. (************************************************************************)
  196.  
  197.  
  198. procedure open;
  199.  
  200.     begin
  201.           get_filename;
  202.           writeln('The file is being opened Sharable Read Write...');
  203.         writeln('This is accomplished by placing a hex 42 in the AL register');
  204.           write('Type return to continue...');
  205.         readln;
  206.           flag:=$42;
  207.           clrscr;
  208.           retcode:=xtndopn(flag,handle,filename);
  209.           if retcode <> 0 then 
  210.         writeln('Return code = ',hexconvert(retcode),' file has not been opened')
  211.           else         
  212.                begin
  213.                     writeln('The file handle is ',handle,' the return code is : ',retcode);
  214.                     writeln('Remember the file handle number above, it will be needed to release locked records.');
  215.                end;
  216.      end;
  217.  
  218.  
  219. (*************************************************************************)
  220. (* Get or Set file Attributes *)
  221. (*************************************************************************)
  222.  
  223. procedure setget;
  224.     var get:integer;
  225.  
  226.     begin
  227.       get:=0;
  228.       get_filename;
  229.       writeln('Enter a ''0'' to get the atributes');
  230.     write('Enter a ''1'' to set the attributes: ');
  231.       readln(func);
  232.       if func = 1 then
  233.            begin
  234.                 writeln('Enter one of the following attributes: ');
  235.                 writeln;
  236.             writeln('1 - Read only. 2 - Hidden. 4 - system. 128 - Sharable.');
  237.             readln(attribute);
  238.            end
  239.       else 
  240.         get:=1;
  241.       retcode:=setattr(FUNC,ATTRIBUTE,filename);
  242.       write('executing... ');
  243.       if get = 1 then 
  244.         writeln(' The attribute is : ',hexconvert(attribute));
  245.       writeln('The return code is: ',hexconvert(retcode));
  246.     end;
  247.  
  248. (************************************************************************)
  249. (* Set EOJ flag *)
  250. (************************************************************************)
  251.  
  252.  
  253. procedure SetEOJ;
  254.     
  255.     begin
  256.       writeln('Enter a ''0'' to disable the End Of Job flag');
  257.     writeln('Enter a ''1'' to enable the End Of Job flag.');
  258.       readln(flag);
  259.       retcode:=eojstat(flag);
  260.       writeln('The return code is: ',retcode);
  261.     end;
  262.  
  263.  
  264. (************************************************************************)
  265. (* Physical record LOG and LOCK  *)
  266. (************************************************************************)
  267.  
  268.  
  269. procedure Log_Lock;
  270.  
  271.     begin
  272.        ans:='n';
  273.        write('If the target file is already open, type a ''y'': ');
  274.     readln(ans);
  275.        if ans <> 'y' then 
  276.         OPEN
  277.        else
  278.             begin
  279.              write('Enter the appropriate file handle: ');
  280.         readln(handle);
  281.             end;
  282.        write('Enter the Low Word Starting Offset of the record: ');
  283.     readln(Loff);
  284.        write('Enter the High Word Starting Offset of the record: ');
  285.     readln(Hoff);
  286.        write('Enter the Low Word Length of the record: ');
  287.     readln(LLen);
  288.        write('Enter the High Word Length of the record: ');
  289.     readln(HLen);
  290.        write('Enter a ''1'' to lock and log, or enter a ''3'' to do a shared lock: ');
  291.     readln(flag);
  292.        if flag = 1 then
  293.             begin
  294.              write('Enter the lock timeout in 1/18 secs intervals: ');
  295.         readln(TMO);
  296.             end;
  297.        retcode:=PRLH_Log(handle,Hoff,Loff,HLen,LLen,Flag,TMO);
  298.        writeln('The return code is: ',retcode);
  299.     end;
  300.  
  301.  
  302. (**************************************************************************)
  303. (* Release a record but it still remains in the log table. *)
  304. (* Release a record and remove it from the log table (clear the record).*)
  305. (**************************************************************************)
  306.  
  307.  
  308. procedure Rel_Clr;
  309.  
  310.     begin
  311.        ans:='n';
  312.        writeln('To release a record you must have opened the file and obtained a valid file handle.');
  313.      write('To proceed type a ''y'': ');
  314.     readln(ans);
  315.        if ans = 'y' then
  316.            begin
  317.             write('Enter the file handle of the appropriate file: ');
  318.         readln(handle);
  319.             write('Enter the Low Word Starting Offset of the record: ');
  320.         readln(Loff);
  321.             write('Enter the High Word Starting Offset of the record: ');
  322.         readln(Hoff);
  323.             write('Enter the Low Word Length of the record: ');
  324.         readln(LLen);
  325.             write('Enter the High Word Length of the record: ');
  326.         readln(HLen);
  327.             write('If you want to release the record, but not remove it from the log table, type an ''r'': ');
  328.             readln(ans);
  329.             if ans ='r' then
  330.                  begin
  331.                   writeln('Releasing the record...');
  332.                   retcode:=PRLH_Rel(handle,Hoff,Loff,HLen,LLen);
  333.                      end
  334.             else
  335.                  begin
  336.                   writeln('Removing the record from the log table...');
  337.                   retcode:=PRLH_Clr(handle,Hoff,Loff,HLen,LLen);
  338.                  end;
  339.             writeln('The return code is: ',retcode);
  340.            end;
  341.     end;
  342.  
  343.  
  344. (*********************************************************************)
  345. (* Lock the record set (all records in the log table *)
  346. (* Release record set or clear the record set.
  347. (*********************************************************************)
  348.  
  349.  
  350. procedure Lock_Set;
  351.     
  352.     begin
  353.       write('Enter a ''1'' to do a shared lock, nonexclusive:  ');
  354.       readln(flag);
  355.       write('Enter the timeout amount in 1/18 secs intervals, 0 means no wait: ');
  356.     readln(TMO);
  357.       retcode:=PRLS_Lck(flag,TMO);
  358.       writeln('The return code is: ',retcode);
  359.     end;
  360.  
  361.  
  362. procedure Set_Rel_Clr;
  363.  
  364.     begin
  365.        ans:='n';
  366.        writeln('To release the entire record set without removing the records');
  367.      write('from the log table, enter  an ''r'': ');
  368.     readln(ans);
  369.        if ans = 'r' then
  370.             begin
  371.              writeln('Releasing the record set...');
  372.              retcode:=PRLS_Rel;
  373.             end
  374.        else
  375.             begin
  376.              write('Removing all records from log table...');
  377.              retcode:=PRLS_Clr;
  378.             end;
  379.        write('Return code is : ',retcode);
  380.     end;
  381.  
  382.  
  383. (**********************************************************************)
  384. (* Open a Semaphore *)
  385. (**********************************************************************)
  386.  
  387.  
  388. procedure Sem_Open;
  389.  
  390.     begin
  391.     write('Enter the name of the semaphore: ');
  392.     readln(sema4);
  393.       write('Enter the initial semaphore value, it must be positive: ');
  394.     readln(semavalu);
  395.       retcode:=opensem(sema4,semavalu,Hihandle,Lohandle,opencnt);
  396.       writeln;
  397.     writeln;
  398.       writeln('The return code is : ',retcode);
  399.     writeln('The number of stations using this semaphore is : ',opencnt);
  400.       write('The semaphore handle is : HiPart = ',hexconvert(Hihandle));
  401.       hex:=' ';
  402.       writeln(' LoPart = ',hexconvert(Lohandle));
  403.       writeln('WRITE DOWN THIS HANDLE EXACTLY AS YOU SEE IT, IT WILL BE NEDDED TO ACCESS THIS SEMAPHORE');
  404.       writeln;
  405.     end;
  406.  
  407.  
  408. procedure Sem_Exam;
  409.  
  410.     begin
  411.         writeln('When entering the file handle, enter the HEX digits in the following manner: ');
  412.       writeln('    ie.    low part first: $adcb  (put a ''$'' before the hex digits) ');
  413.       writeln;
  414.       write('Enter the semaphore handle, low part first: ');readln(Lohandle);
  415.       write('  enter the high part of the handle: ');
  416.     readln(Hihandle);
  417.       retcode:=ExamSem(Hihandle,Lohandle,semavalu,opencnt);
  418.       writeln('The return code is : ',retcode);
  419.       writeln('The open count is : ',opencnt);
  420.       writeln('The semaphore value is : ',semavalu);
  421.     end;
  422.  
  423.  
  424. procedure Sem_Wait_Sig;
  425.  
  426.     begin
  427.       ans:='n';
  428.       writeln('When entering the file handle, enter the HEX digits in the following manner: ');
  429.       writeln('    ie.    low part first: $adcb  (put a ''$'' before the hex digits) ');
  430.       writeln;
  431.       write('Enter the semaphore handle, low part first: ');
  432.     readln(Lohandle);
  433.       write('  enter the high part of the handle: ');
  434.     readln(Hihandle);
  435.       writeln('     If you desire to SIGNAL the semaphore (increment) ');
  436.       write('  enter an ''s'', else type return: ');
  437.       readln(ans);
  438.       if ans = 's' then 
  439.         retcode:= SigSem(Hihandle,Lohandle)
  440.       else
  441.            begin
  442.             write('Enter the timeout value in 1/18 secs intervals: ');
  443.         readln(TMO);
  444.         writeln;
  445.             write('waiting... ');
  446.             retcode:=WaitSem(Hihandle,Lohandle,TMO);
  447.            end;
  448.       writeln('The return code is : ',retcode);
  449.     end;
  450.  
  451.  
  452. procedure Sem_Close;
  453.  
  454.     begin
  455.       writeln('When entering the file handle, enter the HEX digits in the following manner: ');
  456.       writeln('    ie.    low part first: $adcb  (put a ''$'' before the hex digits) ');
  457.       writeln;
  458.       write('Enter the semaphore handle, low part first: ');
  459.     readln(Lohandle);
  460.       write('  enter the high part of the handle: ');
  461.     readln(Hihandle);
  462.       retcode:= ClosSem(Hihandle,Lohandle);
  463.       writeln('    closing... the return code is : ',retcode);
  464.     end;
  465.  
  466.  
  467. (************************************************************************)
  468. (* GetOrSet_LockMode sets the Lock Mode to 01 as explained in Function      *)
  469. (* call guide.                                                          *)
  470. (************************************************************************)
  471.  
  472.  
  473. procedure GetOrSet_LockMode;
  474.  
  475.     begin
  476.        writeln('Enter one of the following choices: ');
  477.     writeln;
  478.        writeln('      0 - set to old compatibility mode');
  479.        writeln('      1 - set to new extended locks mode');
  480.        write('      2 - return current lock mode    ---->  ');
  481.     readln(func);
  482.        retcode:=setlck(func);
  483.        writeln('The current lock mode is ',retcode);
  484.     end;
  485.  
  486.  
  487. (************************************************************************)
  488. (* Transaction Tracking Begin, End, TTS verify, Abort trans,
  489.    Transaction status *)
  490. (************************************************************************)
  491.  
  492. procedure TTS_functions;
  493.  
  494.     begin
  495.       writeln('Enter a TTS function code 0');
  496.     writeln('Enter a ''0'' to begin a transaction');
  497.     writeln('Enter a ''1'' to end a transaction (Note - NO Transaction Reference No. is returned)');
  498.     writeln('Enter a ''2'' to verify whether or not the preferred file server supports transaction tracking');
  499.     writeln('Enter a ''3'' to abort a transaction');
  500.     readln(func);
  501.       retcode:=BakOuts(func);
  502.       writeln('The return code is : ',retcode);
  503.     end;
  504.  
  505.  
  506. (*************************************************************************)
  507. (* Begin or End logical locking read-modify-update cycle *)
  508. (*************************************************************************)
  509.  
  510.  
  511. procedure Logical_Begin_End;
  512.  
  513.     begin
  514.       writeln('To begin logical locking enter a ''b''');
  515.     writeln('To end logical locking enter an ''e''');
  516.     write('------->');
  517.     readln(ans);
  518.       if ans = 'b' then
  519.            begin
  520.             ans:='n';
  521.             write('This function assumes that the Lock Mode has been set to 1. If true, type a ''y'' : ');
  522.         readln(ans);
  523.             if ans = 'y' then
  524.                  begin
  525.                   write('Enter the time out amount in 1/18 secs intervels : ');
  526.             readln(TMO);
  527.                   retcode:=btrans(TMO);    
  528.             write('Logical locking installed');
  529.                  end;
  530.            end
  531.       else
  532.         begin
  533.                 retcode:=etrans;
  534.         write('Logical locking ended');
  535.         end;
  536.       writeln('The return code is : ',retcode);
  537.     end;
  538.  
  539.  
  540. (**************************************************************************)
  541. (* Logical record lock functions--Log, Lock, Unlock, Unlock set, Clear rec,
  542.    Clear set *)
  543. (**************************************************************************)
  544.  
  545.  
  546. procedure Logical_locking;
  547.  
  548.     begin
  549.       ans:='n';
  550.       write('This procedure assumes the Lock Mode has been set to 1 if true enter ''y'' : ');
  551.     readln(ans);
  552.       if ans = 'y' then
  553.        begin
  554.             writeln('Choose one of the following functions: ');
  555.             writeln('    0 - Log and Lock a logical record');
  556.             writeln('    1 - Lock all the logical records in the log table');
  557.             writeln('    2 - Release a logical record lock, but do not remove it from the log table');
  558.             writeln('    3 - Release all the logical records in the log table');
  559.             writeln('    4 - Release and remove a logical record from the log table');
  560.             writeln('    5 - Release and remove the entire logical record set from the log table');
  561.             write(' ----> ');
  562.         readln(ans);
  563.             if ans ='0' then
  564.              begin
  565.                   clrscr;
  566.                       writeln('You have chosen to Log and Lock a record ');
  567.             writeln;
  568.                   writeln('Enter a ''1'' to Log and Lock the record (exclusive lock)');
  569.             writeln('Enter a ''3'' to Log and Lock the record (non-exclusive lock)');
  570.             write('------->');        
  571.             readln(flag);
  572.                   write('Enter the record string to lock : ');
  573.             readln(recstr);
  574.                   write('Enter the time out amount in 1/18 sec intervals : ');
  575.             readln(TMO);
  576.                   retcode:=reclog(recstr,flag,TMO);
  577.              end
  578.             else if ans = '1' then
  579.              begin
  580.                   clrscr;
  581.                   writeln('You have chosen to Lock the Record Set ');
  582.                   write('Enter the time out in 1/18 sec intervels : ');
  583.             readln(TMO);
  584.                   retcode:=reclck(TMO);
  585.              end
  586.             else if ans = '2' then
  587.              begin
  588.                   clrscr;
  589.                   writeln('You have chosen to release a record');
  590.                   write('Enter the name of the record string : ');
  591.             readln(recstr);
  592.                   retcode:=reculk(recstr);
  593.              end
  594.             else if ans = '3' then
  595.              begin
  596.                       retcode:=reculks;
  597.                   write('Record set released');
  598.              end
  599.             else if ans = '4' then
  600.              begin
  601.                   clrscr;
  602.                   writeln('You have chosen to clear a record');
  603.                   write('Enter the name of the record string : ');
  604.             readln(recstr);
  605.                   retcode:=recclr(recstr);
  606.              end
  607.             else if ans = '5' then
  608.              begin
  609.                   retcode:=recclrs;
  610.                   write('Record Set Cleared');
  611.              end;
  612.              writeln('The return code is : ',retcode);
  613.        end;
  614.     end;
  615.  
  616.  
  617. (**********************************************************************)
  618. (* Execute an End Of Job call *)
  619. (**********************************************************************)
  620.  
  621.  
  622. procedure EndOfJob;
  623.  
  624.     begin
  625.     retcode:=eoj;
  626.     writeln('EOJ function call completed');
  627.       writeln('The return code is : ',retcode);
  628.     end;
  629.  
  630.  
  631. (********************************************************************)
  632. (* Logout from the network *)
  633. (********************************************************************)
  634.  
  635.  
  636. procedure Sys_logout;
  637.  
  638.     begin
  639.     writeln('Executing the logout function call');
  640.       retcode:=sysout;
  641.       writeln('The return code is : ',retcode);
  642.     end;
  643.  
  644.  
  645. (*******************************************************************)
  646. (* Get the volume statistics *)
  647. (*******************************************************************)
  648.  
  649.  
  650. procedure Get_Vol_Stat;
  651.  
  652.     begin
  653.       write('Enter the volume number : ');
  654.     readln(volume);
  655.     reply:='hi there';
  656.       retcode:=volstat(volume,reply);
  657.       writeln('The return code is : ',retcode);
  658.       writeln;
  659.       writeln('Number of sectors per block : ',ord(reply[1]),ord(reply[2]));
  660.       writeln('Number of total blocks : ',ord(reply[3]),ord(reply[4]));
  661.       writeln('Number of unused blocks : ',ord(reply[5]),ord(reply[6]));
  662.       writeln('Number of directory entries : ',ord(reply[7]),ord(reply[8]));
  663.       writeln('Number of unused directory entries : ',ord(reply[9]),ord(reply[10]));
  664.       write('Volume Name : ',reply[11],reply[12],reply[13],reply[14],reply[15],reply[16]);
  665.       write(reply[17],reply[18],reply[19],reply[20],reply[21],reply[22]);
  666.       writeln(reply[23],reply[24],reply[25],reply[26]);
  667.       writeln('Removeable flag - 00 if volume is not removeable : ',ord(reply[27]),ord(reply[28]));
  668.     end;
  669.  
  670.  
  671. (***********************************************************************)
  672. (* Find number of local disk that the shell has drives mapped to *)
  673. (***********************************************************************)
  674.  
  675.  
  676. procedure Number_Loc_drv;
  677.     
  678.     begin
  679.       retcode:=locdrv;
  680.       writeln('Number of local drives : ',retcode);
  681.     end;
  682.  
  683.  
  684. (***********************************************************************)
  685. (* Get the Logical station number *)
  686. (***********************************************************************)
  687.  
  688.  
  689. procedure Logical_Sta_Num;
  690.  
  691.     begin
  692.       retcode:=wsid;
  693.       writeln('The logical station number is : ',retcode);
  694.     end;
  695.  
  696.  
  697. (*************************************************************************)
  698. (* SetErrorMode sets the Error Mode to 1, so that the program will       *)
  699. (* have control.                                                         *)
  700. (*************************************************************************)
  701.  
  702.  
  703. procedure SetErrorMode;
  704.     begin
  705.       writeln('To set the error mode');
  706.       writeln('Enter one of the following : ');
  707.       writeln('      0 - to display errors on screen');
  708.       writeln('      1 - Extended errors for all file I/O returned in AL');
  709.       writeln('      2 - Critical errors returned in AL (only Netware 2.x and up)');
  710.       write('------>  ');
  711.     readln(func);
  712.       retcode:=errmode(func);
  713.       writeln('The previous error mode was : ',retcode);
  714.     end;
  715.  
  716.  
  717. (*************************************************************************)
  718. (* This function allows programs to change the way the shell treats network *)
  719. (* broadcast messages. *)
  720. (*************************************************************************)
  721.  
  722.  
  723. procedure Change_Bcast;
  724.  
  725.     begin
  726.       writeln('To set the broadcast mode, choose one of the following : ');
  727.       writeln('       0 - Receive console and workstation broadcasts');
  728.       writeln('       1 - Receive console broadcasts only');
  729.       writeln('       2 - Disable receipt of all broadcasts');
  730.       writeln('       3 - Store broadcast messages');
  731.       writeln('       4 - Return current broadcast mode');
  732.       writeln('       5 - Shell timer interrupt checks are disabled');
  733.       writeln('       6 - Shell timer interrupts are enabled');
  734.       write('---->  ');
  735.     readln(func);
  736.       retcode:=bcsmode(func);
  737.       writeln;writeln('The current mode is : ',retcode);
  738.     end;
  739.  
  740.  
  741. (************************************************************************)
  742. (* The Modify LST Device function enables the use of the network spool device*)
  743. (************************************************************************)
  744.  
  745.  
  746. procedure Spool_func;
  747.  
  748.     begin
  749.       writeln('You have chosen to start your spool device, enter one of the following :');
  750.       writeln('       0 - Start the LST catch');
  751.       writeln('       1 - End the LST catch and queue for printing');
  752.       writeln('       2 - End the LST catch and abort print');
  753.       writeln('       3 - Queue for printing and restart LST catch');
  754.       write('---->  ');
  755.     readln(func);
  756.       retcode:=ctlspl(func);
  757.       writeln;
  758.     writeln('The return code is : ',retcode);
  759.     end;
  760.  
  761.  
  762. (*********************************************************************)
  763. (* Spool data to a capture file located on the server *)
  764. (*********************************************************************)
  765.  
  766.  
  767. procedure Spool_Capture;
  768.     var packet, tab, copy, prnt, form: integer;
  769.         ban: str;
  770.         res: char;
  771.  
  772.     begin
  773.       ans:='n';
  774.       writeln('Choose one of the following spool functions : ');
  775.       writeln('              0 - Spool data to a capture file on the server');
  776.       writeln('              1 - Close and Queue or Abort the capture file');
  777.       writeln('              2 - Set the spool flags');
  778.       write('---->  ');
  779.     readln(func);
  780.     writeln;
  781.       if func = 0 then
  782.            begin
  783.             writeln('Enter a string to be spooled (length = 1 to 52) :');
  784.             readln(request);
  785.             request:=chr(length(request) + 1) + chr(0) + chr(func) + request;
  786.            end
  787.       else if func = 1 then
  788.            begin
  789.             write('If you want to ABORT the queue type a ''y'' : ');
  790.         readln(ans);
  791.             if ans = 'y' then
  792.                   request:=chr(2) + chr(0) + chr(func) + chr(255)
  793.             else 
  794.             request:=chr(1) + chr(0) + chr(func);
  795.            end
  796.       else if func = 2 then
  797.            begin
  798.             write('Do you want a banner page? (y/n) : ');
  799.         readln(ans);
  800.             if ans = 'y' then 
  801.             packet:=21 else packet:=6;
  802.         writeln('Enter the print flags, the choices are: ');
  803.             writeln('    08h - Suppress auto form feed at the end of a print job');
  804.             writeln('    20h - Delete spool file after printing');
  805.             writeln('    40h - Enable tab expansion');
  806.             writeln('    80h - Print a banner page');
  807.             writeln('  example: to suppress form feed and print a banner page add the two numbers');
  808.             writeln('    in HEX --> 008h + 80h = 88h.   TO ENTER --> $88 ($ = HEX) ');
  809.         writeln;
  810.             write('--->  ');
  811.         readln(flag);
  812.         writeln;
  813.             write('Enter the Tab size 1..20 : ');
  814.         readln(tab);
  815.             write('Enter the target printer 0..p : ');
  816.         readln(prnt);
  817.             write('Enter the number of copies to print 0..255 (0 copies = no printing : ');
  818.         readln(copy);
  819.             write('Enter the form type 0..255 : ');
  820.         readln(form);
  821.             write('Enter the string for the banner 1..13 chars : ');
  822.         readln(ban);
  823.             request:=chr(packet)+chr(0)+chr(2)+chr(flag)+chr(tab)+chr(prnt)+chr(copy)+chr(form)+res+ban+chr(0);
  824.         end;
  825.       reply:=chr(0) + chr(0);
  826.       retcode:=splreq(request,reply);
  827.       writeln('The return code is : ',retcode);
  828.     end;
  829.  
  830.  
  831. (*************************************************************************)
  832. (* Network Communication Function Calls-- Pipes and broadcast *)
  833. (*************************************************************************)
  834.  
  835.  
  836. procedure Pipes;
  837.     var numsta,stanum: integer;
  838.         message: str;
  839.     
  840.     begin
  841.         writeln('Choose one of the following piping functions: ');
  842.       writeln;
  843.       writeln('       0 - Send a broadcast message');
  844.       writeln('       1 - Get a broadcast message');
  845.       writeln('       2 - Disable station broadcasts');
  846.       writeln('       3 - Enable station broadcasts');
  847.       writeln('   Pipe functions can be added, see function call manual');
  848.       writeln;
  849.       write('-----> ');
  850.     readln(func);
  851.     writeln;
  852.       reply:=chr(255)+chr(0);
  853.       if func = 0 then
  854.            begin
  855.             writeln('For our purposes, only one station needs to receive the message ');
  856.             write('Enter the station number: ');
  857.         readln(stanum);
  858.         numsta:=1;
  859.             write('Enter the string you want to send: ');
  860.         readln(message);
  861.             request:= chr(length(message)+4)+chr(0)+chr(0)+chr(numsta)+chr(stanum)+chr(length(message))+message;
  862.             retcode:=pipreq(request,reply);
  863.            end
  864.       else if func = 1 then
  865.            begin
  866.             request:=chr(1)+chr(0)+chr(1);
  867.             retcode:=pipreq(request,reply);
  868.             reply[0]:=chr(ord(reply[3])+3);    { makes printable to screen }
  869.                 reply[3]:=chr(0);                  { "       "   "       "     "   "    }
  870.             writeln(reply);
  871.            end
  872.       else if func = 2 then
  873.            begin
  874.             request:=chr(1)+chr(0)+chr(2);
  875.             retcode:=pipreq(request,reply);
  876.            end
  877.       else if func = 3 then
  878.            begin
  879.             request:=chr(1)+chr(0)+chr(3);
  880.             retcode:=pipreq(request,reply);
  881.            end;
  882.       writeln;
  883.       writeln('Error code is: ',retcode);
  884.     end;
  885.  
  886.  
  887. (************************************************************************)
  888. (* Directory Request functions *)
  889. (************************************************************************)
  890.  
  891.  
  892. procedure directory;
  893.     var sbase: integer;
  894.      
  895.     begin
  896.       writeln('Get the Base Path Mapping for the entered drive');
  897.       write('Enter a SOURCEBASE (drive handle--1 or 2): ');
  898.     readln(sbase);
  899.       request:=chr(2)+chr(0)+chr(1)+chr(sbase);
  900.       reply:=chr(255)+chr(0);
  901.       retcode:=dpath(request,reply);
  902.       reply[0]:=chr(ord(reply[3])+3);
  903.       reply[3]:=chr(0);
  904.       writeln('Return code is: ',retcode);
  905.       writeln(reply);
  906.     end;
  907.  
  908.  
  909. (*************************************************************************)
  910. (* Log request functions  *)
  911. (**************************************************************************)
  912.  
  913.  
  914. procedure SystemLog;
  915.     var connection: integer;
  916.  
  917.     begin
  918.       writeln('Get a Stations Logged Information');
  919.       write('Enter the logical station number or connection number:  ');
  920.       readln(connection);
  921.       request:=chr(2)+chr(0)+chr(5)+chr(connection);
  922.       reply:=chr(255)+chr(1);
  923.       retcode:=syslog(request,reply);
  924.       reply[0]:=chr(255);
  925.       writeln('The return code is: ',retcode);
  926.       writeln('The return string is: ');
  927.       writeln(reply);
  928.     end;
  929.  
  930.  
  931. (************************************************************************)
  932. (* Get the Date/Time String *)
  933. (************************************************************************)
  934.  
  935.  
  936. procedure GetTime;
  937.     var time:str;
  938.  
  939.     begin
  940.       retcode:=nettod(time);  { The value in the str is found at byte#-1 }
  941.       writeln('The return code is: ',retcode);
  942.       writeln('The month/day/year is: ',ord(time[1]),'/',ord(time[2]),'/',ord(time[0]));
  943.       writeln('The time is: ',ord(time[3]),':',ord(time[4]),':',ord(time[5]));
  944.       case ord(time[6]) of
  945.            0:writeln('The day is Sunday');
  946.            1:writeln('The day is Monday');
  947.            2:writeln('The day is Tuesday');
  948.            3:writeln('The day is Wednesday');
  949.            4:writeln('The day is Thursday');
  950.            5:writeln('The day is Friday');
  951.            6:writeln('The day is Saturday');
  952.       end;
  953.     end;
  954.  
  955.  
  956. (*************************************************************************)
  957. (* Get the shell's Base Status *)
  958. (*************************************************************************)
  959.  
  960.  
  961. procedure driveHand;
  962.     var drive: integer;
  963.  
  964.     begin
  965.         write('Enter the drive number to check (A = 0, B = 1 etc.): ');
  966.     readln(drive);
  967.       retcode:=drvmap(drive);
  968.       writeln('The network pathbase (drive handle) is: ',retcode);
  969.     end;
  970.  
  971.  
  972. (*************************************************************************)
  973. (* Return the Shell Version *)
  974. (*************************************************************************)
  975.  
  976.  
  977. procedure RetShellVer;
  978.     var envirstr: str;
  979.         mode: integer;
  980.  
  981.     begin
  982.       writeln('Enter the mode:');
  983.     writeln('   0 - Find hardware type only');
  984.       writeln('   1 - get the OS, version and hardware type');
  985.       write('------>  ');
  986.     readln(mode);
  987.       if mode = 0 then
  988.            begin
  989.             retcode:=retshl(envirstr,mode);
  990.             writeln('Hardware type is: ',retcode);
  991.             writeln('The type is defined as follows, 0 - IBM PC, 1 - Victor 9000');
  992.            end
  993.       else
  994.            begin
  995.             retcode:=retshl(envirstr,mode);
  996.             envirstr[0]:=chr(30);
  997.             writeln(envirstr);
  998.            end;
  999.      end;
  1000.  
  1001.  
  1002. (*************************************************************************)
  1003. (* Log and/or Lock an ASCIIZ String *)
  1004. (*************************************************************************)
  1005.  
  1006.  
  1007. procedure AsciizStr;
  1008.     begin
  1009.       writeln('Choose one of the following:');
  1010.     writeln('    0 - Log or Lock the Asciiz string');
  1011.       writeln('    1 - Release an Asciiz string');
  1012.       writeln('    2 - Clear an Asciiz string');
  1013.       write('-------> ');
  1014.     readln(func);
  1015.       writeln;
  1016.       if func = 0 then
  1017.            begin
  1018.             writeln('Type a ''0'' if you only want to log the string');
  1019.         writeln('Type a ''1'' if you want to log and lock the string');
  1020.         write('------->');
  1021.         readln(flag);
  1022.             write('Enter the string name: ');
  1023.         readln(asciiz);
  1024.             asciiz[length(asciiz)+1]:=chr(0);
  1025.             writeln(asciiz);
  1026.             write('Enter the desired timeout value in 1/18 second intervals: ');
  1027.         readln(TMO);
  1028.             writeln;
  1029.             retcode:=asclog(flag,TMO,asciiz);
  1030.            end
  1031.       else if func = 1 then
  1032.            begin
  1033.             write('Enter the name of the string to be released: ');
  1034.         readln(asciiz);
  1035.             asciiz[length(asciiz)+1]:=chr(0);   { Make an asciiz string }
  1036.             retcode:=asculkf(asciiz);
  1037.            end
  1038.       else if func = 2 then
  1039.            begin
  1040.                 write('Enter the name of the string to be cleared: ');
  1041.         readln(asciiz);
  1042.             asciiz[length(asciiz)+1]:=chr(0);   {Make an asciiz string }
  1043.             retcode:=ascclrf(asciiz);
  1044.            end;
  1045.        writeln('The return code is: ',retcode);
  1046.     end;
  1047.  
  1048.  
  1049. (************************************************************************)
  1050. (* Get Physical station Number--switch setting on the Network Interface Card*)
  1051. (************************************************************************)
  1052.  
  1053.  
  1054. procedure GetPhsNum;
  1055.     
  1056.     begin
  1057.       retcode:=get_psn;
  1058.       writeln('The Physical Station Number is : ',retcode);
  1059.     end;
  1060.  
  1061.  
  1062. (************************************************************************)
  1063. (* Get the Shell table Addresses *)
  1064. (************************************************************************)
  1065.  
  1066.  
  1067. procedure GetShlAdr;
  1068.  
  1069.     begin
  1070.       writeln('Enter one of the following choices: ');
  1071.       writeln('         0 - Get the Drive Handle Table');
  1072.       writeln('         1 - Get the Drive Flag Table');
  1073.       writeln('         2 - Get the Drive Server Table');
  1074.       writeln('         3 - Get the Server Mapping Table');
  1075.       write('----->  ');
  1076.     readln(mode);
  1077.       retcode:=get_sta(mode,seg,off);
  1078.       writeln;
  1079.       writeln('These segment and offset addresses have been displayed in decimal');
  1080.       writeln;
  1081.       writeln('The segment address is: ',seg);
  1082.       writeln('The offset address is: ',off);
  1083.     end;
  1084.  
  1085.  
  1086. (************************************************************************)
  1087. (* Set the preferred File Server *)
  1088. (************************************************************************)
  1089.  
  1090.  
  1091. procedure PrefServ;
  1092.  
  1093.     begin
  1094.       writeln('Enter one of the following: ');
  1095.       writeln('        0 - Set the preferred file server');
  1096.       writeln('        1 - Get the preferred file server');
  1097.       writeln('        2 - Get the Effective File Server');
  1098.       writeln('        3 - Get the Spooled file server');
  1099.       writeln('        4 - Set the primary file server');
  1100.       writeln('        5 - Get the Primary file server');
  1101.       write('----->  ');
  1102.     readln(mode);
  1103.       writeln;
  1104.       write('Enter the preferred server 1-8:  ');
  1105.     readln(newserv);
  1106.       retcode:=setserv(mode,newserv);
  1107.       writeln('The return code is:  ',retcode);
  1108.     end;
  1109.  
  1110.  
  1111. (************************************************************************)
  1112. (* Attach or Detach to a file server *)
  1113. (************************************************************************)
  1114.  
  1115.  
  1116. procedure AttDetServ;
  1117.    
  1118.     begin
  1119.       writeln('Enter one of the following: ');
  1120.       writeln('       0 - Attach to a specfied server');
  1121.       writeln('       1 - Logout and detach from a specified server');
  1122.       writeln('       2 - Logout but do not dettach from a specified server');
  1123.       write('----> ');
  1124.     readln(mode);
  1125.       writeln;
  1126.       write('Enter the specified server numbers 1-8: ');
  1127.     readln(newserv);
  1128.       writeln;
  1129.       retcode:=modserv(mode,newserv);
  1130.       writeln('The return code is: ',retcode);
  1131.     end;
  1132.  
  1133.  
  1134.  
  1135. (*************************************************************************)
  1136.  
  1137.  
  1138. procedure menu;
  1139.     var stop:boolean;
  1140.  
  1141.     begin
  1142.       repeat
  1143.           clrscr;
  1144.           stop:=false;
  1145.           hex:=' ';
  1146.           writeln('Choose one of the following: ');
  1147.           writeln('0 - Get or Set the lock mode');
  1148.           writeln('1 - OPEN a file');
  1149.           writeln('2 - SET or Get a files attributes');
  1150.           writeln('3 - Check the EOJ status');
  1151.           writeln('4 - Log and Lock a record');
  1152.           writeln('5 - Release a locked record');
  1153.           writeln('6 - Lock a record set, all the records in the stations log table');
  1154.           writeln('7 - Release a locked record set');
  1155.           writeln('8 - Open a semaphore');
  1156.           writeln('9 - Examine a semaphore');
  1157.           writeln('A - Wait semaphore (decrement value) or Signal semaphore (increment value)');
  1158.           writeln('B - Close a semaphore');
  1159.           writeln('C - TTS Functions');
  1160.           writeln('D - Begin or End logical locking read_modify_update cycle');
  1161.           writeln('E - Logical locking functions');
  1162.           writeln('F - Execute an End Of Job');
  1163.           writeln('G - Logout');
  1164.           writeln('Z - Quit');
  1165.           writeln;
  1166.           writeln('  ENTER A CORRESPONDING CHARACTER OR TYPE RETURN TO SEE THE REST OF THE MENU ');
  1167.           writeln('******************************************************************************');
  1168.           write('----> ');
  1169.         readln(ans);
  1170.       if NOT
  1171.        (ans IN ['0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f','g','z','A','B','C','D','E','F','G','Z']) then
  1172.                begin
  1173.                 clrscr;
  1174.                 writeln('H - Get the volume statistics');
  1175.                 writeln('I - Get the number of local drives');
  1176.                 writeln('J - Get the logical station number');
  1177.                 writeln('K - Set the error mode');
  1178.                 writeln('L - Set the broadcast mode');
  1179.                 writeln('M - Start the spooler under program control');
  1180.                 writeln('N - Various spooling functions');
  1181.                 writeln('O - Piping functions');
  1182.                 writeln('P - Directory Functions');
  1183.                 writeln('Q - Sytem log functions');
  1184.                 writeln('R - Get the Date/Time string');
  1185.                 writeln('S - Get the shells Base Status');
  1186.                 writeln('T - Get the shell version');
  1187.                 writeln('U - Log, Lock, Release and clear an Asciiz string.');
  1188.                 writeln('     Any Asciiz string function are assuming the Lock mode is 1');
  1189.                 writeln('V - Get the Physical Station Number');
  1190.                 writeln('W - Get the shell table addresses');
  1191.                 writeln('X - Get the preferred server, different functions');
  1192.                 writeln('Y - Attach or Detach a specified server');
  1193.                 writeln('Z - Quit');
  1194.                 writeln;
  1195.                 writeln('       ENTER A CORRESPONDING CHARACTER OR TYPE RETURN TO SEE MENU AGAIN...');
  1196.                 writeln('******************************************************************************');
  1197.                 write('------> ');
  1198.             readln(ans);
  1199.               end;    
  1200.           clrscr;
  1201.           case ans of
  1202.                '0':GetOrSet_LockMode;
  1203.                '1':OPEN;
  1204.                '2':SETGET;
  1205.                '3':SetEOJ;
  1206.                '4':Log_Lock;
  1207.                '5':Rel_Clr;
  1208.                '6':Lock_Set;
  1209.                '7':Set_Rel_Clr;
  1210.                '8':Sem_Open;
  1211.                '9':Sem_Exam;
  1212.                'a', 'A':Sem_Wait_Sig;
  1213.                'b', 'B':Sem_Close;
  1214.                'c', 'C':TTS_Functions;
  1215.                'd', 'D':Logical_Begin_End;
  1216.                'e', 'E':Logical_Locking;
  1217.                'f', 'F':EndOfJob;
  1218.                'g','G':Sys_logout;
  1219.                'h', 'H':Get_Vol_Stat;
  1220.                'i', 'I':Number_loc_drv;
  1221.                'j', 'J':Logical_Sta_Num;
  1222.                'k', 'K':SetErrorMode;
  1223.                'l', 'L':Change_Bcast;
  1224.                'm', 'M':Spool_Capture;
  1225.                'n', 'N':Spool_Capture;
  1226.                'o', 'O':Pipes;
  1227.                'p', 'P':Directory;
  1228.                'q', 'Q':SystemLog;
  1229.                'r', 'R':GetTime;
  1230.                's', 'S':DriveHand;
  1231.                't', 'T':RetShellVer;
  1232.                'u', 'U':AsciizStr;
  1233.                'v', 'V':GetPhsNum;
  1234.                'w', 'W':GetShlAdr;
  1235.                'x', 'X':PrefServ;
  1236.                'y', 'Y':AttDetServ;
  1237.                'z', 'Z':stop:=true;
  1238.             end;
  1239.             if stop = FALSE then
  1240.                 begin
  1241.                      writeln;
  1242.                 writeln;
  1243.                      write('Type return to continue... ');
  1244.                 readln;
  1245.                 end;
  1246.        until stop = true;
  1247.     end;
  1248.  
  1249.  
  1250.  
  1251. (**************************** MAIN PROGRAM ******************************)
  1252.  
  1253.  
  1254.     begin
  1255.         clrscr;
  1256.         writeln;writeln;writeln;writeln;
  1257.         writeln('                  SAMPLE FUNCTION CALL LIBRARY INTERFACE ');
  1258.         write('         please type return to continue... ');
  1259.         readln;
  1260.         writeln;
  1261.         explain;
  1262.         writeln;writeln;writeln;writeln;
  1263.         func:=1;
  1264.         retcode:=errmode(func);
  1265.         writeln('The ERROR MODE has been set to 1, to proceed type return');
  1266.         readln;writeln;
  1267.         menu;
  1268.     end.
  1269.